home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / monolith / ISTLY.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  3.3 KB  |  100 lines
  1.         PROGRAM ISTLY
  2.  
  3.         INTEGER IODSRC,IODCMT,IODTRE,IODSYM,IODCI,NERROR,NWARN,
  4.      +          SRCPTH(134),CMTPTH(134),TREPTH(134),
  5.      +          SYMPTH(134),CIPTH(134)
  6.  
  7.         INTEGER YPARSE,GETARG,OPEN,CREATE
  8.         EXTERNAL YPARSE,ZINIT,ZMESS,ERROR,ZQUIT,GETARG,OPEN,CREATE,
  9.      +           ZCHOUT,ZPTINT,PUTCH
  10.  
  11.         CALL ZINIT
  12.         CALL INISTR
  13.         CALL INISYM
  14.         CALL INITRE
  15.  
  16.         IF (GETARG(1,SRCPTH,81).EQ.-100) CALL NAMES(1,SRCPTH)
  17.         IF (GETARG(2,CMTPTH,81).EQ.-100) CALL NAMES(2,CMTPTH)
  18.         IF (GETARG(3,TREPTH,81).EQ.-100) CALL NAMES(3,TREPTH)
  19.         IF (GETARG(4,SYMPTH,81).EQ.-100) CALL NAMES(4,SYMPTH)
  20.         IF (GETARG(5,CIPTH,81).EQ.-100) CALL NAMES(5,CIPTH)
  21.  
  22.         IODSRC=OPEN(SRCPTH,0)
  23.         IF (IODSRC.EQ.-1) CALL ERROR('Source File Open Failed.')
  24.         IODCMT=CREATE(CMTPTH,1)
  25.         IF (IODCMT.EQ.-1) CALL ERROR('Comment File Create Failed.')
  26.         IODTRE=CREATE(TREPTH,1)
  27.         IF (IODTRE.EQ.-1) CALL ERROR('Tree Path Create Failed.')
  28.         IODSYM=CREATE(SYMPTH,1)
  29.         IF (IODSYM.EQ.-1) CALL ERROR('Symbol table Create Failed.')
  30.         IODCI=CREATE(CIPTH,1)
  31.         IF (IODCI.EQ.-1) CALL ERROR('Comment index Create Failed.')
  32.  
  33.         IF (YPARSE(IODSRC,IODCMT,IODSYM,IODCI,NERROR,NWARN).EQ.0) THEN
  34.             CALL ZYSOUT(IODSYM)
  35.             CALL ZYTOUT(IODTRE)
  36.             IF (NERROR+NWARN.EQ.0) THEN
  37.                 CALL ZMESS('[ISTLY Normal Termination].',1)
  38.                 CALL ZQUIT(-2)
  39.             ELSE IF (NERROR.EQ.0) THEN
  40.                 CALL ZCHOUT('[ISTLY Terminated, .',1)
  41.                 CALL ZPTINT(NWARN,1,1)
  42.                 CALL ZCHOUT(' war'//'ning.',1)
  43.                 IF (NWARN.GT.1) CALL PUTCH(115,1)
  44.                 CALL ZMESS('].',1)
  45.                 CALL ZQUIT(-1002)
  46.             ELSE
  47.                 CALL ZCHOUT('[ISTLY Terminated, .',1)
  48.                 CALL ZPTINT(NERROR,1,1)
  49.                 CALL ZCHOUT(' er'//'ror.',1)
  50.                 IF (NERROR.GT.1) CALL PUTCH(115,1)
  51.                 CALL ZMESS('].',1)
  52.                 CALL ZQUIT(-1)
  53.             END IF
  54.         ELSE
  55.             CALL ERROR('[ISTLY Fatal Error -- Terminated].')
  56.         END IF
  57.  
  58.         END
  59. C ----------------------------------------------------------------------
  60. C
  61. C       N A M E S   -   Input the pathname of a required file from stdin
  62. C
  63.  
  64.         SUBROUTINE NAMES(NUMBER,PATH)
  65.         INTEGER NUMBER,PATH(*)
  66.  
  67.         INTEGER JUNK,PROMPT(23,5)
  68.  
  69.         SAVE PROMPT
  70.  
  71.         INTEGER ZGTCMD
  72.         EXTERNAL ZGTCMD,ZPRMPT
  73.  
  74. C "Input source file: "
  75. C "Output comment file: "
  76. C "Output parse tree: "
  77. C "Output symbol table: "
  78. C "Output comment index: "
  79.  
  80.         DATA (PROMPT(I,1),I=1,20)/73,110,112,117,116,32,115,
  81.      +111,117,114,99,101,32,102,105,108,101,58,
  82.      +32,129/,
  83.      +       (PROMPT(I,2),I=1,22)/79,117,116,112,117,116,32,
  84.      +99,111,109,109,101,110,116,32,102,105,108,101,
  85.      +58,32,129/,
  86.      +       (PROMPT(I,3),I=1,20)/79,117,116,112,117,116,32,
  87.      +112,97,114,115,101,32,116,114,101,101,58,32,
  88.      +129/,
  89.      +       (PROMPT(I,4),I=1,22)/79,117,116,112,117,116,32,
  90.      +115,121,109,98,111,108,32,116,97,98,108,101,
  91.      +58,32,129/,
  92.      +       (PROMPT(I,5),I=1,23)/79,117,116,112,117,116,32,
  93.      +99,111,109,109,101,110,116,32,105,110,100,101,120,
  94.      +58,32,129/
  95.  
  96.         CALL ZPRMPT(PROMPT(1,NUMBER))
  97.         JUNK=ZGTCMD(PATH,0)
  98.  
  99.         END
  100.